In ylleonv/pack: What the Package Does (One Line, Title Case)

Tutz's example

vignette("multinomial-travel") #Tutz example with mlogit and VGAM

Example 8.4: Travel Mode (Tutz) The choice of travel mode of n = 840 passengers in Australia was investigated by Greene (2003). The data are available from the R package Ecdat. The alternatives of travel mode were air, train, bus, and car, which have frequencies 0.276, 0.300, 0.142, and 0.280. Air serves as the Reference categoryegory. As category-specific variables we consider travel time in vehicle (invt) and cost (gc), and as the global variable we consider household income (hinc). The estimates given in Table 8.4 show that income seems to be influential for the pReference of train and bus over airplane. Moreover, time in vehicle seems to matter for the pReference of the travel mode. Cost turns out to be non-influential if income is in the predictor.

devtools::load_all(".")
# vignette("multinomial-travel") #Tutz example with mlogit and VGAM

Library mlogit

library(mlogit)
data(ModeChoice, package="Ecdat")
travel.long <- mlogit.data(ModeChoice, choice="mode", shape="long", alt.levels=
                                c("air","train","bus","car"))
mod_mlogit <- mlogit(mode ~ invt + gc|hinc, data=travel.long)
summary(mod_mlogit)

Library VGAM

library(VGAM)
travelmode <- matrix(ModeChoice$mode, byrow = T, ncol = 4)
colnames(travelmode) <- c("air","train","bus","car")
travelhinc <- matrix(ModeChoice$hinc, byrow = T, ncol = 4)
travelhinc <- travelhinc[,1]
travelinvt <- matrix(ModeChoice$invt, byrow = T, ncol = 4)
colnames(travelinvt) <- c("invtair","invttrain","invtbus","invtcar")
travelgc <- matrix(ModeChoice$gc, byrow = T, ncol = 4)
colnames(travelgc) <- c("gcair","gctrain","gcbus","gccar")
travelinvt <- sweep(travelinvt[,-1], 1, travelinvt[,1])
travelgc <- sweep(travelgc[,-1], 1, travelgc[,1])
Invt <- travelinvt[,1]
Gc <- travelgc[,1]
traveldat <- cbind(travelhinc, travelinvt, Invt, travelgc, Gc)
traveldat <- as.data.frame(traveldat)

head(travelmode)
head(traveldat)
mod_vgam <- vglm(travelmode ~ Invt + Gc + travelhinc,
            multinomial(parallel = FALSE ~ travelhinc, refLevel = 1),
            xij = list(Invt ~ invttrain + invtbus + invtcar,
            Gc ~ gctrain + gcbus + gccar),
            form2 = ~ Invt + invttrain + invtbus + invtcar +
            Gc + gctrain + gcbus + gccar + travelhinc,
            data = traveldat, trace = TRUE)
mod_vgam

Proposed library

{
  library(mlogit)
  data(ModeChoice, package = "Ecdat")
  head(ModeChoice)
  travel.long <- mlogit.data(ModeChoice, choice = "mode", shape = "long", alt.levels = c("air", "train", "bus", "car"))
  head(travel.long)
  choice <- sub(".*\\.", "", rownames(travel.long))
  indv <- sub("\\..*", "", rownames(travel.long))
  travel.long88 <- as.data.frame(cbind(indv, choice, travel.long))
}
tail(travel.long88, 4)

Model

mod_pack <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc"),
  category_specific = c("gc", "invt"),
  distribution = "logistic",
  reference_category = c("train", "bus", "car", "air"),
  dataframe = travel.long88
)
mod_pack

Note: If just air, then the design is different since air is the first category of the alphabetical order air, bus, car, train.

(exp_8_3 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc"),
  category_specific = c("gc", "invt"),
  distribution = "logistic",
  reference_category = "air",
  dataframe = travel.long88
))

3. MOD 3

Louviere design

(exp_8_3_lo <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-train"),
  category_specific = c("gc", "invt"),
  distribution = "logistic",
  reference_category = "bus",
  dataframe = travel.long88
))

4. MOD 4

(car_0 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept-train", "hinc-air",  "psize-bus"),
  category_specific = c("gc", "ttme"),
  distribution = "logistic",
  reference_category = c("air", "train", "bus", "car"),
  dataframe = travel.long88)
)

Peyhardi's article

Robustness of Student link function in multinomial choice models

5 a, Reference, logistic, complete (intercept), proportional (HINC, PSIZE), cat-specific (GC, ttme)

The log-likelihood obtained with the MNL is −185.91 as obtained by Louviere et al. (2000) page 157.

(car_0 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-air",  "psize-air"),
  category_specific = c("gc", "ttme"),
  distribution = "logistic",
  reference_category = c("air", "train", "bus", "car"),
  dataframe = travel.long88)
)

5 b, Reference, logistic, complete (intercept), proportional (HINC, PSIZE), cat-specific (GC, ttme)

The log-likelihood obtained with the MNL is −185.91 as obtained by Louviere et al. (2000) page 157.

(car_1 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-air",  "psize-air"),
  category_specific = c("gc", "ttme"),
  distribution = "logistic",
  reference_category = c("air", "bus", "train", "car"),
  dataframe = travel.long88)
)

The log-likelihoods obtained with the (Reference, F ν ∗ , Z) j 0 models were −185.65, −183.79, −142, −183.49 respectively with the four Reference alternatives j 0 =air, j 0 =bus, j 0 =car, j 0 =train and correspondind degree of freedom ν ∗ = 3, ν ∗ = 30, ν ∗ = 0.2, ν ∗ = 1.35.

6 a. Reference category: bus, Df = 30, LogLik = −183.79

(bus_30 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-air", "psize-air"),
  category_specific = c("gc", "ttme"),
  distribution = "student",
  reference_category = c("air", "train", "car", "bus"),
  dataframe = travel.long88,
  freedom_degrees = 30
))

6 b. Reference category: bus, Df = 30, LogLik = −183.79

(bus_30 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-air", "psize-air"),
  category_specific = c("gc", "ttme"),
  distribution = "student",
  reference_category = c("air", "car", "train", "bus"),
  dataframe = travel.long88,
  freedom_degrees = 30
))

7. Reference category: train, Df = 1.35, LogLik = −183.49

(train_1.35 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-air", "psize-air"),
  category_specific = c("gc", "ttme"),
  distribution = "student",
  reference_category = "train",
  dataframe = travel.long88,
  freedom_degrees = 1.35
))

8. Reference category: car, Df = 0.2, LogLik = −142

(car_02 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-air", "psize-air"),
  category_specific = c("gc", "ttme"),
  distribution = "student",
  reference_category = c("air", "train", "bus", "car"),
  dataframe = travel.long88,
  freedom_degrees = 0.2
))

9. Reference category: air, Df = 3, LogLik = −185.65

(air_3 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept", "hinc-air", "psize"),
  category_specific = c("gc", "ttme"),
  distribution = "student",
  reference_category = "air",
  dataframe = travel.long88,
  freedom_degrees = 3
))

10. (reference, logistic, Z) ref - car model using the normalized space Fq0.95

(table4 <- Discrete_CM(
  response = "choice", 
  individual_choice = "mode",
  individuals = "indv",
  explanatory_global = c("intercept"),
  category_specific = c("ttme"),
  distribution = "logistic",
  reference_category = c("air", "train", "bus", "car"),
  dataframe = travel.long88,
))

ylleonv/pack documentation built on June 29, 2020, 10:36 p.m.